ETO Development Tools 2/ETO Development Tools 2.iso/Tools - Objects/MacApp/MacApp CD Release/MacApp 2.0.1 (Many Libraries)/Libraries/UMemory.inc1.p

Text File | 1990-10-25 | 40.9 KB | 1,702 lines | [TEXT/MPS ]

{$P}
{[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
{ UMemory.inc1.p }
{ Copyright © 1985-1990 by Apple Computer, Inc.  All rights reserved. }

{$IFC NOT qDebugTheDebugger}
{$W+}
{$R-}
{$Init-}
{$OV-}
{$ENDC}

VAR
    pDuringGrowZone: BOOLEAN;

FUNCTION GrowZoneProc(needed: Size): LONGINT;
    FORWARD;

PROCEDURE BuildCodeReserve(allocLim: Size;
                           fromGZ: BOOLEAN);
    FORWARD;

FUNCTION HandleIsEligible(h: Handle): BOOLEAN;
    FORWARD;

{--------------------------------------------------------------------------------------------------}

PROCEDURE ALoadMacAppSeg;
    EXTERNAL;

PROCEDURE APostLoadMacAppSeg;
    EXTERNAL;
 { LoadSeg is Patched to call ALoadMacAppSeg, which in turn calls
  LoadMacAppSegment. ALoadMacAppSeg can only be referenced as a
  procedure pointer, because no args are declared }

PROCEDURE EachFrameDo(calleeFrame, ppc: LONGINT;
                      PROCEDURE DoToFrame(calleeFrame: LONGINT;
                                          ppc: LONGINT;
                                          callerFrame: LONGINT;
                                          itsFrame: LONGINT));
    EXTERNAL;

FUNCTION PreloadSegment(segNum: INTEGER): BOOLEAN;
    EXTERNAL;

PROCEDURE CallNotify(h: Handle;
                     routine: ProcPtr);
    INLINE $205F, $4E90;                                { MOVE.L (A7)+,A0; JSR (A0) }

{--------------------------------------------------------------------------------------------------}

    {
    These "MAFoo" functions are primarily for THINK™ Pascal compatibility (but useful in the larger
    problem of multiple open resource maps in general); when running under the THINK™ environment,
    CODE resources are not found in the same resource file as other application resources, so a
    UseResFile call needs to be made to bring the project resource file into the search path.
    "gCodeRefNum" is set up at initialization time.
    !!! A much more general solution to "the resource problem" appears to be warranted.
    }

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

FUNCTION MAGet1Resource(rType: ResType;
                        rID: INTEGER): Handle;

    VAR
        oldResFile:         INTEGER;

    BEGIN
    oldResFile := MAUseResFile(gCodeRefNum);
    MAGet1Resource := Get1Resource(rType, rID);
    IF MAUseResFile(oldResFile) <> 0 THEN;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

FUNCTION MAGet1NamedResource(rType: ResType;
                             name: Str255): Handle;

    VAR
        oldResFile:         INTEGER;

    BEGIN
    oldResFile := MAUseResFile(gCodeRefNum);
    MAGet1NamedResource := Get1NamedResource(rType, name);
    IF MAUseResFile(oldResFile) <> 0 THEN;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

FUNCTION MAGet1IndResource(rType: ResType;
                           index: INTEGER): Handle;

    VAR
        oldResFile:         INTEGER;

    BEGIN
    oldResFile := MAUseResFile(gCodeRefNum);
    MAGet1IndResource := Get1IndResource(rType, index);
    IF MAUseResFile(oldResFile) <> 0 THEN;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

FUNCTION MACount1Resources(rType: ResType): INTEGER;

    VAR
        oldResFile:         INTEGER;

    BEGIN
    oldResFile := MAUseResFile(gCodeRefNum);
    MACount1Resources := Count1Resources(rType);
    IF MAUseResFile(oldResFile) <> 0 THEN;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

FUNCTION MAGetResource(rType: ResType;
                       rID: INTEGER): Handle;

    VAR
        h:                    Handle;
        oldResFile:         INTEGER;

    BEGIN
    oldResFile := MAUseResFile(gCodeRefNum);
    h := GetResource(rType, rID);
    IF MAUseResFile(oldResFile) <> 0 THEN;

    IF HomeResFile(h) <> gCodeRefNum THEN
        h := NIL;

    MAGetResource := h;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

FUNCTION MAGetNamedResource(rType: ResType;
                            name: Str255): Handle;

    VAR
        h:                    Handle;
        oldResFile:         INTEGER;

    BEGIN
    oldResFile := MAUseResFile(gCodeRefNum);
    h := GetNamedResource(rType, name);
    IF MAUseResFile(oldResFile) <> 0 THEN;

    IF HomeResFile(h) <> gCodeRefNum THEN
        h := NIL;

    MAGetNamedResource := h;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

FUNCTION MAGetIndResource(rType: ResType;
                          index: INTEGER): Handle;

    VAR
        h:                    Handle;
        oldResFile:         INTEGER;

    BEGIN
    oldResFile := MAUseResFile(gCodeRefNum);
    h := GetIndResource(rType, index);
    IF MAUseResFile(oldResFile) <> 0 THEN;

    IF HomeResFile(h) <> gCodeRefNum THEN
        h := NIL;

    MAGetIndResource := h;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

FUNCTION MACountResources(rType: ResType): INTEGER;

    VAR
        oldResFile:         INTEGER;

    BEGIN
    oldResFile := MAUseResFile(gCodeRefNum);
    MACountResources := CountResources(rType);
    IF MAUseResFile(oldResFile) <> 0 THEN;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

FUNCTION GetSegResource(segNum: INTEGER): Handle;

    BEGIN
    IF qNeedsROM128k | gConfiguration.hasROM128k THEN
        GetSegResource := MAGet1Resource(kCode, segNum)
    ELSE
        GetSegResource := MAGetResource(kCode, segNum);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAMiniInit}

PROCEDURE AddAllRsrc(rType: ResType;
                     toList: HandleListHandle);

    VAR
        oldResLoad:         BOOLEAN;
        i:                    INTEGER;
        h:                    Handle;
        theID:                INTEGER;
        theType:            ResType;
        theName:            Str255;

    BEGIN
    oldResLoad := GetResLoad;
    SetResLoad(FALSE);

    FOR i := 1 TO CountResources(rType) DO
        BEGIN
        h := GetIndResource(rType, i);
        GetResInfo(h, theID, theType, theName);

  { If there is a ROM resource for this type and ID, don't put it
   on the list. }
        UseROMMap(FALSE);
        h := GetResource(rType, theID);
        UseROMMap(FALSE);
        IF HomeResFile(h) <> 1 THEN
            AddHandle(h, toList);

        END;

    SetResLoad(oldResLoad);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAMiniInit}

PROCEDURE AddHandle(h: Handle;
                    toList: HandleListHandle);

    VAR
        offset:             LONGINT;

    BEGIN
    offset := Munger(Handle(toList), 0, NIL, 0, @h, 4);
    FailMemError;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAMiniInit}

FUNCTION AddSegSizes(segRsrc: Handle): LONGINT;

    VAR
        p:                    SignedBytePtr;
        oldResLoad:         BOOLEAN;
        total:                LONGINT;
        seg:                Handle;
        i:                    INTEGER;
        s:                    Str255;

    BEGIN
    LockHandleHigh(segRsrc);

    oldResLoad := GetResLoad;
    SetResLoad(FALSE);

    p := SignedBytePtr(segRsrc^);
    i := IntegerPtr(p)^;
    p := SignedBytePtr(Ord(p) + 2);

    total := 0;

    WHILE i > 0 DO
        BEGIN
        BlockMove(Ptr(p), @s, p^ + 1);

        p := SignedBytePtr(Ord(p) + p^ + 1);
        i := i - 1;

        IF qNeedsROM128k | gConfiguration.hasROM128k THEN
            seg := MAGet1NamedResource(kCode, s)
        ELSE
            seg := MAGetNamedResource(kCode, s);

        IF seg <> NIL THEN
            total := total + SizeResource(seg) + 8;
        END;

    AddSegSizes := total;

    SetResLoad(oldResLoad);

    HUnlock(segRsrc);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}
{$Push} {$IFC qTrace} {$D+} {$ENDC}

PROCEDURE BuildAllReserves;

    CONST
        initVal             = $F7;

    VAR
        oldPerm:            BOOLEAN;
        {$IFC qDebug}
        theSize:            Size;
        {$EndC}

    BEGIN
  { set the permanent flag to ensure that the code reserve is
   actually allocated and not given up to the low space reserve }
    oldPerm := pPermAllocation;
    pPermAllocation := TRUE;

    { make sure code reserve is OK }
    BuildCodeReserve(kGZMaxAlloc, FALSE);

    { reallocate the low space handle, if necessary }
    IF IsHandlePurged(pMemReserve) THEN
        BEGIN

        ReallocHandle(pMemReserve, pSzMemReserve);
        {$IFC qDebug}
        theSize := GetHandleSize(pMemReserve);
        {$Push} {$R-}
        IF theSize <> 0 THEN
            BlockSet(pMemReserve^, theSize, initVal);
        {$Pop}
        {$EndC}
        END;

    { reset the permanent flag }
    pPermAllocation := oldPerm;
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}
{$Push} {$IFC qTrace} {$D+} {$ENDC}

PROCEDURE BuildCodeReserve(allocLim: Size;
                           fromGZ: BOOLEAN);

    CONST
        initVal             = $F7;

    VAR
        needed:             Size;
        avail:                Size;
        canPurge:            Handle;
        {$IFC qDebug}
        theSize:            Size;
        {$EndC}

    BEGIN
    pOKCodeReserve := TRUE;                             { default value }

    {$IFC qDebug}
    pReserveShortfall := 0;

    IF NOT pPermAllocation THEN
        ProgramBreak('BuildCodeReserve called with pPermAllocation = FALSE');
    {$ENDC qDebug}

    IF NOT pReserveExists THEN
        BEGIN
        pReserveExists := TRUE;                         { default value }

        { free the current code reserve }
        IF HandleIsEligible(pCodeReserve) THEN
            EmptyHandle(pCodeReserve);

        { compute amt actually needed }
        needed := Min(pSzCodeReserve - TotalTempSize(FALSE, canPurge) - 8, allocLim);

        IF needed > 0 THEN
            BEGIN
            { make as much memory available as possible }
            IF HandleIsEligible(pMemReserve) THEN
                EmptyHandle(pMemReserve);

            IF fromGZ THEN                                { Never purge or compact from GrowZone }
                avail := allocLim
            ELSE
                BEGIN
                PurgeMem(needed);
                avail := CompactMem(needed);
                END;

            IF avail < needed THEN                        { could not get the whole reserve }
                BEGIN
                {$IFC qDebug}
                pReserveShortfall := needed - avail;
                {$ENDC}

                pOKCodeReserve := FALSE;
                pReserveExists := FALSE;

                needed := avail;                        { get the most we can }
                END;

            IF (NOT fromGZ) & (IsHandlePurged(pCodeReserve) | HandleIsEligible(pCodeReserve)) THEN
                    ReallocHandle(pCodeReserve, needed);
            {$IFC qDebug}
            theSize := GetHandleSize(pCodeReserve);
            {$Push} {$R-}
            IF theSize <> 0 THEN
                BlockSet(pCodeReserve^, theSize, initVal);
            {$Pop}
            {$EndC}
            IF NOT IsHandlePurged(pCodeReserve) THEN
                BEGIN
                { Large handles are almost as bad as nonrelocatable blocks.
                    Try to get this guy out of the way, just in case.}
                IF NOT fromGZ THEN
                    MoveHHi(pCodeReserve);
                END;
            END;
        END;
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

FUNCTION CheckReserve: BOOLEAN;

    BEGIN
    BuildAllReserves;
    CheckReserve := pOKCodeReserve;
    END;

{--------------------------------------------------------------------------------------------------}
{$IFC qDebug}
{$S MAMemoryRes}

PROCEDURE CheckRsrcUsage;

    VAR
        sz:                 LONGINT;
        h:                    Handle;
        s:                    Str255;

    BEGIN
    sz := TotalTempSize(TRUE, h);
    IF sz > gMaxLockedRsrc THEN
        BEGIN
        gMaxLockedRsrc := sz;
        IF gRsrcReport THEN
            BEGIN
            NumToString(gMaxLockedRsrc, s);
            s := Concat('  == New maximum resources usage: ', s, ' ==');
            ProgramReport(s, gMemMgtBreak);
            END;
        END;
    END;
{$ENDC qDebug}

{--------------------------------------------------------------------------------------------------}
{$IFC qDebug}
{$S MADebug}

PROCEDURE DoChangeReserve(alter: BOOLEAN;
                          VAR codeReserve, codeShort, lowSpaceReserve: LONGINT;
                          VAR gotCode, gotLowSpace: BOOLEAN);

    VAR
        x:                    LONGINT;
        s:                    Str255;

    BEGIN
    IF alter THEN
        BEGIN
        Write('code reserve size = ', pSzCodeReserve: 1, '  ');
        IF pOKCodeReserve THEN
            Writeln(' (OK)')
        ELSE
            Writeln(' (gone)');

        Write('low space reserve size = ', pSzMemReserve: 1, '  ');
        IF NOT IsHandlePurged(pMemReserve) THEN
            Writeln(' (OK)')
        ELSE
            Writeln(' (gone)');

        Writeln;

        Write('New code reserve (-1 = no change): ');
        Readln(x);
        IF x >= 0 THEN
            codeReserve := x
        ELSE
            codeReserve := pSzCodeReserve;

        Write('New low space reserve (-1 = no change): ');
        Readln(x);
        IF x >= 0 THEN
            lowSpaceReserve := x
        ELSE
            lowSpaceReserve := pSzMemReserve;

        Write('Reset max resource usage (Y or N) [N]? ');
        Readln(s);
        IF s <> '' THEN
            IF (s[1] = 'y') | (s[1] = 'Y') THEN
                BEGIN
                gMaxLockedRsrc := 0;
                END;

        Writeln;

        SetReserveSize(codeReserve, lowSpaceReserve);
        END
    ELSE
        BuildAllReserves;

    codeReserve := pSzCodeReserve;
    codeShort := pReserveShortfall;
    lowSpaceReserve := pSzMemReserve;
    gotCode := pOKCodeReserve;
    gotLowSpace := NOT IsHandlePurged(pMemReserve);
    END;
{$ENDC qDebug}

{--------------------------------------------------------------------------------------------------}
{$S MAMiniInit}

PROCEDURE DoInitUMemory(VAR sizeTempReserve, sizeLowSpaceReserve: Size);

 { Called from InitUMemory so that InitUMemory can be in the main segment
  and this code can be in another (unloadable) segment. }

    TYPE
        Mem                 = RECORD                    { format of the mem! resource }
            codeVal, lowSpaceVal, stackVal: LONGINT;
            END;
        MemPtr                = ^Mem;
        MemHandle            = ^MemPtr;

    VAR
        i:                    INTEGER;
        oldResLoad:         BOOLEAN;
        seg:                Handle;
        StackTot:            LONGINT;
        h:                    Handle;
        rsrcID:             INTEGER;
        rsrcType:            ResType;
        rsrcName:            Str255;
        lastRsrc:            INTEGER;
        mainSegment, utilitySegment: INTEGER;

    BEGIN
    { Initialize memory management globals }
    pPermAllocation := FALSE;
    pMemReserve := NewHandle(0);
    FailNil(pMemReserve);

    pSzMemReserve := 0;
    pCodeReserve := NewHandle(0);
    FailNil(pCodeReserve);

    pSzCodeReserve := 0;
    gGZPurgeNotify := NIL;
    pOKCodeReserve := TRUE;
    pReserveExists := FALSE;
    {$IFC qDebug}
    gSegReport := FALSE;
    {$EndC}

    gUnloadAllSegs := TRUE;

    gCodeRefNum := HomeResFile(GetResource(kCode, 1));    { Get homeresfile of "Main".
                                                        It better be there!!}
    pMaxSegNum := 0;

    {###########################################}
    { No resource loading }

    oldResLoad := GetResLoad;
    SetResLoad(FALSE);

    { Figure the highest segment number }
    IF qNeedsROM128k | gConfiguration.hasROM128k THEN
        lastRsrc := MACount1Resources(kCode)
    ELSE
        lastRsrc := MACountResources(kCode);

    { some development systems may not have contiguous numbering of CODE segments.
    try to be polite about handling it }
    FOR i := 1 TO lastRsrc DO
        BEGIN
        IF qNeedsROM128k | gConfiguration.hasROM128k THEN
            seg := MAGet1IndResource(kCode, i)
        ELSE
            seg := MAGetIndResource(kCode, i);
        { we only have an index… find the real resource ID and keep track
        of the highest one }
        IF (seg <> NIL) THEN
            BEGIN
            GetResInfo(seg, rsrcID, rsrcType, rsrcName);
            pMaxSegNum := Max(rsrcID, pMaxSegNum);
            END;
        END;


    SetResLoad(oldResLoad); { in case of failure }

    { Allocate the master segment lists.}
    gCodeSegs := HandleListHandle(NewHandle(pMaxSegNum * SizeOf(Handle)));
    FailNil(gCodeSegs);

    gIsResidentSeg := BoolListHandle(NewHandle(SizeOf(BOOLEAN) * pMaxSegNum));
    FailNil(gIsResidentSeg);

    gIsLoadedSeg := BoolListHandle(NewHandle(SizeOf(BOOLEAN) * pMaxSegNum));
    FailNil(gIsLoadedSeg);

    { (NOTE: assumes application doesn't change the CODE segment size at runtime
    (a very safe assumption)). Used in GetSegFromPC. }
    pSegSize := LongListHandle(NewHandle(SizeOf(LONGINT) * pMaxSegNum));
    FailNil(pSegSize);

    oldResLoad := GetResLoad; { OK, suppress segment loading again }
    SetResLoad(FALSE);    { !!! Need an MAResLoad that returns old state }

    { Initialize segment lists.}
    FOR i := 1 TO pMaxSegNum DO
        gIsResidentSeg^^[i] := FALSE;

    { Segments and their sizes and actual loaded state (helps catch preloads) }
    FOR i := 1 TO pMaxSegNum DO
        BEGIN
        seg := GetSegResource(i);
        gCodeSegs^^[i] := seg;
        if seg <> NIL THEN { seg is non-nil if the segment number exists }
            BEGIN
            pSegSize^^[i] := SizeResource(seg);
            gIsLoadedSeg^^[i] := IsHandleLocked(seg);
            END
        ELSE
            BEGIN
            pSegSize^^[i] := 0;
            gIsLoadedSeg^^[i] := FALSE;
            END;
        END;

    SetResLoad(oldResLoad);
    {###########################################}

    mainSegment := GetSegNumber(@InitUMemory);            { Main is always resident }
    gIsResidentSeg^^[mainSegment] := TRUE;
    gIsLoadedSeg^^[mainSegment] := TRUE;

    utilitySegment := GetSegNumber(@UnloadAllSegments); { Utilities are always resident }
    gIsResidentSeg^^[utilitySegment] := TRUE;
    gIsLoadedSeg^^[utilitySegment] := TRUE;

    { init the gSysMemList }
    gSysMemList := HandleListHandle(NewHandle(0));
    FailNil(gSysMemList);

    AddAllRsrc('LDEF', gSysMemList);
    AddAllRsrc('CDEF', gSysMemList);
    AddAllRsrc('MDEF', gSysMemList);
    AddAllRsrc('WDEF', gSysMemList);
    AddAllRsrc('PACK', gSysMemList);

    { Compute memory slop needed }
    sizeTempReserve := 0;
    sizeLowSpaceReserve := 0;
    StackTot := 0;

    FOR i := 1 TO CountResources('seg!') DO
        BEGIN
        h := GetIndResource('seg!', i);
        sizeTempReserve := sizeTempReserve + AddSegSizes(h);
        ReleaseResource(h);
        END;

    FOR i := 1 TO CountResources('mem!') DO
        BEGIN
        h := GetIndResource('mem!', i);
        WITH MemHandle(h)^^ DO
            BEGIN
            sizeTempReserve := sizeTempReserve + codeVal;
            sizeLowSpaceReserve := sizeLowSpaceReserve + lowSpaceVal;
            StackTot := StackTot + stackVal;
            END;
        ReleaseResource(h);
        END;

    SetStackSpace(StackTot);

    MaxApplZone;

    gApp1MemList := NIL;
    gApp2MemList := NIL;

    END;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

PROCEDURE FailNoReserve;

    BEGIN
    IF NOT CheckReserve THEN
        Failure(memFullErr, 0);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

PROCEDURE FailSpaceIsLow;

{$IFC qDebug}

    VAR
        s:                    MAName;
        {$ENDC}

    BEGIN
    {$IFC qDebug}
    IF gAskFailure & CanReadLn THEN
        BEGIN
        GetCallersMethodName(s);
        IF ReadYesNo(Concat('FailSpaceIsLow called by ', s, '.  Return true(Y or N) [N]? ')) THEN
            Failure(memFullErr, 0);
        END;
    {$ENDC}

    IF MemSpaceIsLow THEN
        Failure(memFullErr, 0);
    END;

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}
{$S MAMemoryRes}

PROCEDURE GetReserveSize(VAR szCodeReserve, szMemReserve: Size);

    BEGIN
    szCodeReserve := pSzCodeReserve;
    szMemReserve := pSzMemReserve;
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}                     { no %_BP/%_EP allowed in here, because we
                                                         cannot call to any other segment from this
                                                         procedure }
{$S MAMemoryRes}                                        { Shouldn't be unloaded }

FUNCTION GetSegFromPC(ppc: LONGINT): INTEGER;

    VAR
        pc:                 LONGINT;
        i:                    INTEGER;
        seg:                Handle;
        segStart:            LONGINT;

    BEGIN
    pc := LongintPtr(ppc)^;

    GetSegFromPC := 0;                                    { default return }

    { Since GetSegFromPC may be called before gCodeSegs is set up, we have to test if gCodeSegs = NIL
    before using it. }
    IF (gCodeSegs <> NIL) THEN
        FOR i := 1 TO pMaxSegNum DO
            BEGIN
            seg := gCodeSegs^^[i];                        { get segment handle }
            IF (seg <> NIL) & NOT IsHandlePurged(seg) THEN { it's in memory }
                BEGIN
                segStart := StripLong(seg^);            { get segment start }
                IF (pc >= segStart) & (pc < segStart + pSegSize^^[i]) THEN
                    BEGIN
                    GetSegFromPC := i;
                    LEAVE;
                    END;
                END;
            END;
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}                     { no %_BP/%_EP allowed in here, because we
                                                         cannot call to any other segment from this
                                                         procedure }
{$S MAMemoryRes}                                        { must be in Main segment because we call
                                                         this in order to make the resident segment
                                                         resident }

FUNCTION GetSegNumber(aProc: ProcPtr): INTEGER;
{ Gets seg number from a Jump table address }

    CONST
        kLoaded             = $4EF9;                    { if loaded then a JMP instruction }
        kUnLoaded            = $3F3C;                    { if unloaded then a LoadSeg trap }

    VAR
        i:                    INTEGER;
        jt:                 LONGINT;
        segNum:             INTEGER;
        seg:                Handle;
        segStart:            LONGINT;

    BEGIN
    IF IntegerPtr(aProc)^ = kLoaded THEN                { loaded segment }
        GetSegNumber := IntegerPtr(Ord(aProc) - 2)^
    ELSE IF IntegerPtr(aProc)^ = kUnLoaded THEN         { unloaded segment }
        GetSegNumber := IntegerPtr(Ord(aProc) + 2)^
    ELSE                                                { routine that computed @proc was in same
                                                         segment as the proc }
        BEGIN
        {$IFC qDebug}
        ProgramBreak('GetSegNumber was not passed an jump table address');
        {$ENDC}
        GetSegNumber := 0;
        END;
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}
{$Push} {$IFC qTrace} {$D+} {$ENDC}

FUNCTION GetSegSize(segNum: INTEGER): Size;

    VAR
        curResLoad:         BOOLEAN;
        seg:                Handle;

    BEGIN
    GetSegSize := pSegSize^^[segNum];
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}
{$Push} {$IFC qTrace} {$D+} {$ENDC}

FUNCTION GrowZoneProc(needed: Size): LONGINT;

    VAR
        result:             LONGINT;
        canPurge:            Handle;
        codeSize:            Size;
        reserveSize:        LONGINT;
        OldA5:                LONGINT;

    BEGIN
    OldA5 := SetCurrentA5;                                { Can be called from other worlds }

    result := 0;                                        { default is to fail }

    IF NOT pDuringGrowZone THEN                            { prevent re-entrancy }
        BEGIN
        pDuringGrowZone := TRUE;

        { on a temp alloc, free all code slack immediately }
        IF NOT pPermAllocation & HandleIsEligible(pCodeReserve) THEN
            BEGIN
            EmptyHandle(pCodeReserve);
            pReserveExists := FALSE;
            result := 1;
            END;

        IF result = 0 THEN                                    { try harder: see if we can purge a code
                                                             segment or reduce the code reserve handle
                                                             }
            BEGIN
            { compute size of resources currently in memory }

            codeSize := TotalTempSize(FALSE, canPurge);

            { see if the code reserve handle is too large }

            IF HandleIsEligible(pCodeReserve) THEN
                { we have a code reserve handle; this implies permanent allocation,
                otherwise the handle would have been emptied above }
                BEGIN
                reserveSize := GetHandleSize(pCodeReserve);

                { the following test is an optimization to avoid calling
                BuildCodeReserve if there is no hope of reducing
                the code reserve handle }
                IF codeSize + reserveSize + 8 > pSzCodeReserve THEN
                    BEGIN                                    { reserve is too big }
                    pReserveExists := FALSE;
                    { this should lower the code reserve }
                    BuildCodeReserve(reserveSize, TRUE);

                    { see if we succeeded in freeing some memory }
                    IF IsHandlePurged(pCodeReserve) THEN
                        result := 1
                    ELSE IF GetHandleSize(pCodeReserve) < reserveSize THEN
                        result := 1;
                    END;
                END;

            IF (result = 0) & (canPurge <> NIL) & (NOT pPermAllocation |
               IsHandlePurged(pCodeReserve)) THEN           { got something; only purge it if this is
                                                             temporary OR we know there is too much
                                                             code in memory already }
                BEGIN
                IF gGZPurgeNotify <> NIL THEN
                    CallNotify(canPurge, gGZPurgeNotify);

                reserveSize := GetHandleSize(canPurge);
                HPurge(canPurge);
                EmptyHandle(canPurge);
                pReserveExists := FALSE;

                IF pPermAllocation THEN                     { don't free too much however }
                    BuildCodeReserve(reserveSize, TRUE);

                result := 1;
                END;
            END;

        IF (result = 0) & HandleIsEligible(pMemReserve) THEN { last ditch attempt-free emergency
                                                              reserve}
            BEGIN
            EmptyHandle(pMemReserve);
            result := 1;
            END;

        pDuringGrowZone := FALSE;
        END;

    GrowZoneProc := result;

    OldA5 := SetA5(OldA5);
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}
{$Push} {$IFC qTrace} {$D+} {$ENDC}

FUNCTION HandleIsEligible(h: Handle): BOOLEAN;

    BEGIN
    IF IsHandlePurged(h) THEN
        HandleIsEligible := FALSE
    ELSE
        HandleIsEligible := (h <> GetGZMoveHnd) & (h <> GetGZRootHnd);
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}                                        { Must be in same segment as grow zone proc
                                                         }
{$Push} {$IFC qTrace} {$D+} {$ENDC}

PROCEDURE InstallGrowZoneProc;
{ Once called the grow zone proc's segment CANNOT be moved since we're passing a NON-JT address
to SetGrowZone (so we can be called from "other worlds" }

    VAR
        aZone:                THz;

    BEGIN
    aZone := ApplicZone;
    aZone^.flags := BOR(aZone^.flags, $0400);
  { set the Memory Manager bit that says to always call the
   Grow Zone proc, even in "non-critical" situations }

    pDuringGrowZone := FALSE;

    SetGrowZone(@GrowZoneProc);

    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S Main}                                                { Must be in main segment and called from
                                                         main segment }

PROCEDURE InitUMemory;

    VAR
        codeRes, lowSpaceRes: Size;
        miniInitSeg, utilitySeg: Handle;
        mainSeg:    integer;

    BEGIN

    { Get these segments out of the way so that when DoInitUMemory gets called and the next
    block of master pointers gets allocated they won't constipate the heap }
    miniInitSeg := GetResource(kCode, GetSegNumber(@DoInitUMemory));
    IF miniInitSeg <> NIL THEN
        BEGIN
        UnLoadSeg(@DoInitUMemory);
        LockHandleHigh(miniInitSeg);
        END;

    DoInitUMemory(codeRes, lowSpaceRes);

    UnloadAllSegments;                                    { get init segment(s) out of middle of heap,
                                                         so SetReserveSize has maximum space to
                                                         work with }

    IF miniInitSeg <> NIL THEN                            { Yes, this would eventually get purged if
                                                         the space was needed badly enough, but
                                                         that happens very late in the game and can
                                                         confound the unwary }
        EmptyHandle(miniInitSeg);

    InstallGrowZoneProc;

    SetReserveSize(codeRes, lowSpaceRes);
    IF NOT pOKCodeReserve THEN                            { couldn't get code reserve. Can't continue
                                                         }
        Failure(memFullErr, 0)
    ELSE
    { Set up the LoadSeg patch }

        FailOSErr(PatchTrap(pSegLoadPatch, _LoadSeg, @ALoadMacAppSeg));

    END;

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}                     { no %_BP/%_EP allowed in here, because we
                                                         cannot call to any other segment from this
                                                         procedure }
{$S MAMemoryRes}                                        { must be in Main segment }

FUNCTION LoadMacAppSegment(segNum: INTEGER): LONGINT;

    VAR
        {$IFC qDebug}
        id:                 INTEGER;
        kind:                ResType;
        segName:            Str255;
        s:                    MAName;
        seg:                Handle;
        {$ENDC}
        A5RegisterOnEntry:    LONGINT;

    BEGIN
    A5RegisterOnEntry := SetCurrentA5;                    { ***** Called from trap patches *****}

    LoadMacAppSegment := pSegLoadPatch.oldTrapAddr;     { Where to go next }

    IF GetA5 <> A5RegisterOnEntry THEN
        BEGIN
        { not called from our application… don't do patch behaviour. Thank you McSink! }
        pLoadSegCalledFromOwnApp := FALSE;
        IF SetA5(A5RegisterOnEntry) <> 0 THEN;
        END
    ELSE
        BEGIN
        pLoadSegCalledFromOwnApp := TRUE;
        pOldResFile := MAUseResFile(gCodeRefNum);        { Must set a global because we return from
                                                         this function and then forward to the
                                                         actual segment loader which should also be
                                                         pointing to the _now_ correct resfile.
                                                         When we get called back again in
                                                         PostLoadMacAppSegment we will restore the
                                                         old resFile as the current resFile. Sorry
                                                         about the global. }

        {$IFC qDebug}
        IF NOT GetResLoad THEN
            BEGIN
            SetResLoad(TRUE);
            ProgramBreak('Whoops… LoadSeg called with resload set false');
            Failure(minErr, 0);                         {??? Assign an error code someday or
                                                         setresload to TRUE ???}
            END;

        {$ENDC}

        IF NOT PreloadSegmentResource(segNum) THEN
            BEGIN
            {$IFC qDebug}
            GetCallersMethodName(s);
            SetResLoad(FALSE);
            IF qNeedsROM128k | gConfiguration.hasROM128k THEN
                seg := MAGet1Resource(kCode, segNum)
            ELSE
                seg := MAGetResource(kCode, segNum);
            GetResInfo(seg, id, kind, segName);
            SetResLoad(TRUE);
            ProgramBreak(Concat('In ', s, ConcatNumber(' couldn''t load segment: ', segNum), ' ',
                                segName));
            {$ENDC}
            Failure(memFullErr, 0)
            END;

        gIsLoadedSeg^^[segNum] := TRUE;

        {$IFC qDebug}
        IF gSegReport THEN
            BEGIN
            { Cause the debugger to break at the start of the next routine. }
            gReportNext := TRUE;
            GetResInfo(gCodeSegs^^[segNum], id, kind, segName);
            gReportInfo := Concat(ConcatNumber('  *** Segment Loaded: ', segNum), ' ', segName);
            gSingleStep := gMemMgtBreak;
            END;
        {$ENDC}

        END;
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}                     { no %_BP/%_EP allowed in here, because we
                                                         cannot call to any other segment from this
                                                         procedure }
{$Z+}
{$S MAMemoryRes}                                        { must be in Main segment }

PROCEDURE PostLoadMacAppSegment;

    VAR
        A5RegisterOnEntry:    LONGINT;

    BEGIN
    A5RegisterOnEntry := SetCurrentA5;                    { ***** Called from trap patches *****}

    IF (GetA5 <> A5RegisterOnEntry) | NOT pLoadSegCalledFromOwnApp THEN
        BEGIN
        { not called from our application… don't do patch behaviour. Thank you McSink! }
        IF SetA5(A5RegisterOnEntry) <> 0 THEN;
        END
    ELSE
    { Called back from our glue.  Restores current res file pointer. }
        BEGIN
        IF pLoadSegCalledFromOwnApp THEN
            IF MAUseResFile(pOldResFile) <> 0 THEN;
        IF SetA5(A5RegisterOnEntry) <> 0 THEN;

        END;
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}                                        { Must be in Main segment }

PROCEDURE LoadResidentSegments;

    VAR
        resIndex:            INTEGER;
        i:                    INTEGER;
        offset:             INTEGER;
        nameList:            Handle;
        segNumber:            INTEGER;
        p:                    SignedBytePtr;
        name:                Str255;
        seg:                Handle;
        theType:            ResType;

    BEGIN
    FOR resIndex := 1 TO CountResources('res!') DO
        BEGIN
        nameList := GetIndResource('res!', resIndex);
        HNoPurge(nameList);

        offset := 2;
        FOR i := 1 TO IntegerPtr(nameList^)^ DO
            BEGIN
            p := SignedBytePtr(ORD4(nameList^) + offset);
            BlockMove(Ptr(p), @name, p^ + 1);
            offset := offset + LENGTH(name) + 1;

            IF qNeedsROM128k | gConfiguration.hasROM128k THEN
                seg := MAGet1NamedResource(kCode, name)
            ELSE
                seg := MAGetNamedResource(kCode, name);
            IF seg <> NIL THEN
                BEGIN
                GetResInfo(seg, segNumber, theType, name);
                SetResidentSegment(segNumber, TRUE);
                END;
            END;

        HPurge(nameList);
        ReleaseResource(nameList);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

FUNCTION MemSpaceIsLow: BOOLEAN;

    BEGIN
    BuildAllReserves;

    MemSpaceIsLow := IsHandlePurged(pMemReserve);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

FUNCTION NewPermHandle(logicalSize: Size): Handle;

    CONST
        initVal             = $F3;                        { odd at all byte boundaries }

    VAR
        priorPerm:            BOOLEAN;
        {$IFC qDebug}
        aHandle:            Handle;
        {$EndC}

    BEGIN
    priorPerm := PermAllocation(TRUE);
    {$IFC NOT qDebug}
    NewPermHandle := NewHandle(logicalSize);
    {$ELSEC}
    aHandle := NewHandle(logicalSize);
    NewPermHandle := aHandle;
    {$Push} {$R-}
    IF aHandle <> NIL THEN
        BlockSet(aHandle^, logicalSize, initVal);
    {$Pop}
    {$EndC}
    pPermAllocation := priorPerm;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

FUNCTION NewPermPtr(logicalSize: Size): Ptr;

    CONST
        initVal             = $F5;                        { odd at all byte boundaries }

    VAR
        priorPerm:            BOOLEAN;
        {$IFC qDebug}
        aPtr:                Ptr;
        {$EndC}

    BEGIN
    priorPerm := PermAllocation(TRUE);
    {$IFC NOT qDebug}
    NewPermPtr := NewPtr(logicalSize);
    {$ELSEC}
    aPtr := NewPtr(logicalSize);
    NewPermPtr := aPtr;
    {$Push} {$R-}
    IF aPtr <> NIL THEN
        BlockSet(aPtr, logicalSize, initVal);
    {$Pop}
    {$EndC}
    pPermAllocation := priorPerm;
    END;

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}
{$S MAMemoryRes}

FUNCTION PermAllocation(permanent: BOOLEAN): BOOLEAN;

    VAR
        b:                    BOOLEAN;

    BEGIN
    PermAllocation := pPermAllocation;

    IF permanent <> pPermAllocation THEN
        BEGIN
        pPermAllocation := permanent;

        IF permanent THEN
            BuildCodeReserve(kGZMaxAlloc, FALSE);
        END;
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}                     { no %_BP/%_EP allowed in here, because we
                                                         cannot call to any other segment from this
                                                         procedure }
{$S MAMemoryRes}                                        { must be in Main segment }

FUNCTION PreloadSegmentResource(segNum: INTEGER): BOOLEAN;

    VAR
        seg:                Handle;
        err:                OSErr;

    PROCEDURE DoGetSegHandle;

        BEGIN
        IF qNeedsROM128k | gConfiguration.hasROM128k THEN
            seg := Get1Resource(kCode, segNum)
        ELSE
            seg := GetResource(kCode, segNum);
        END;

    BEGIN
    IF qDebug & pPermAllocation THEN
        BEGIN
        Writeln('segment # = ', segNum: 1);
        ProgramBreak('Trying to load a segment with PermAllocation = TRUE.');
        END;

    WithCodeResFileDo(DoGetSegHandle);

    IF seg = NIL THEN
        PreloadSegmentResource := FALSE
    ELSE
        BEGIN
        PreloadSegmentResource := TRUE;

        IF NOT IsHandleLocked(seg) THEN                 { not yet locked }
            LockHandleHigh(seg);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

PROCEDURE RemHandle(h: Handle;
                    toList: HandleListHandle);

    VAR
        p:                    LONGINT;
        maxP:                LONGINT;
        offset:             LONGINT;

    BEGIN
    p := Ord(toList^);                                    { Address of first element }
    maxP := p + GetHandleSize(Handle(toList));            { Address past last element }

    { Skip elements until item is found }
    WHILE (p < maxP) & (LongintPtr(p)^ <> Ord(h)) DO
        p := p + SizeOf(Handle);

    IF p < maxP THEN                                    { Item was found }
        BEGIN
        offset := Munger(Handle(toList), p - Ord(toList^), NIL, SizeOf(Handle), @h, 0);
        FailMemError;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}
{$Push} {$IFC qTrace} {$D+} {$ENDC}

PROCEDURE ScanHandles(PROCEDURE DoToHandle(h: Handle));

    PROCEDURE ScanList(list: HandleListHandle);

        TYPE
            HandlePtr            = ^Handle;

        VAR
            i:                    INTEGER;
            p:                    HandlePtr;

        BEGIN
        i := GetHandleSize(Handle(list)) DIV SizeOf(Handle);

        p := HandlePtr(list^);
        WHILE i > 0 DO
            BEGIN
            DoToHandle(p^);
            p := HandlePtr(Ord(p) + SizeOf(Handle));
            i := i - 1;
            END;
        END;

    BEGIN
    ScanList(gCodeSegs);
    IF gApp1MemList <> NIL THEN
        ScanList(gApp1MemList);
    ScanList(gSysMemList);
    IF gApp2MemList <> NIL THEN
        ScanList(gApp2MemList);
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

PROCEDURE SetPermHandleSize(h: Handle;
                            newSize: Size);

    CONST
        initVal             = $F3;                        { odd at all byte boundaries }

    VAR
        priorPerm:            BOOLEAN;
        {$IFC qDebug}
        oldSize:            Size;
        {$EndC}

    BEGIN
    priorPerm := PermAllocation(TRUE);
    {$IFC qDebug}
    oldSize := GetHandleSize(h);
    {$EndC}
    SetHandleSize(h, newSize);
    pPermAllocation := priorPerm;                        { Since we are in the memory unit we can
                                                         break the encapsulation of the
                                                         PermAllocation Call to just set the
                                                         pPermAllocation flag back directly. This
                                                         lets us be assured that no operations have
                                                         occurred that would invalidate the MemErr
                                                         flag… thus the following call will give a
                                                         true result}
    FailMemError;
    {$IFC qDebug}
    {$Push} {$R-}
    IF oldSize < newSize THEN
        BlockSet(Ptr(Ord(h^) + oldSize), newSize - oldSize, initVal);
    {$Pop}
    {$EndC}
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

PROCEDURE SetPermPtrSize(p: Ptr;
                         newSize: Size);

    CONST
        initVal             = $F5;                        { odd at all byte boundaries }

    VAR
        priorPerm:            BOOLEAN;
        {$IFC qDebug}
        oldSize:            Size;
        {$EndC}

    BEGIN
    priorPerm := PermAllocation(TRUE);
    {$IFC qDebug}
    oldSize := GetPtrSize(p);
    {$EndC}
    SetPtrSize(p, newSize);
    pPermAllocation := priorPerm;                        { Since we are in the memory unit we can
                                                         break the encapsulation of the
                                                         PermAllocation Call to just set the
                                                         pPermAllocation flag back directly. This
                                                         lets us be assured that no operations have
                                                         occurred that would invalidate the MemErr
                                                         flag… thus the following call will give a
                                                         true result}
    FailMemError;
    {$IFC qDebug}
    {$Push} {$R-}
    IF oldSize < newSize THEN
        BlockSet(Ptr(Ord(p) + oldSize), newSize - oldSize, initVal);
    {$Pop}
    {$EndC}
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

PROCEDURE SetReserveSize(forCode, forOther: Size);

    VAR
        oldPerm:            BOOLEAN;

    BEGIN
    pSzCodeReserve := forCode;
    pSzMemReserve := forOther;

    { Since the numbers have changed, make sure we start from scratch. }
    pReserveExists := FALSE;
    EmptyHandle(pMemReserve);

    BuildAllReserves;
    END;

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}                     { no %_BP/%_EP allowed in here, because we
                                                         cannot call to any other segment from this
                                                         procedure }
{$S MAMemoryRes}                                        { must be in Main segment }

PROCEDURE SetResidentSegment(segNum: INTEGER;
                             makeResident: BOOLEAN);

    VAR
        {$IFC qDebug}
        id:                 INTEGER;
        kind:                ResType;
        segName:            Str255;
        s:                    MAName;
        {$ENDC}
        seg:                Handle;

    BEGIN
    IF makeResident THEN
        BEGIN
        gIsResidentSeg^^[segNum] := TRUE;
        IF NOT PreloadSegment(segNum) THEN
            BEGIN
            {$IFC qDebug}
            GetCallersMethodName(s);
            SetResLoad(FALSE);
            IF qNeedsROM128k | gConfiguration.hasROM128k THEN
                seg := MAGet1Resource(kCode, segNum)
            ELSE
                seg := MAGetResource(kCode, segNum);
            SetResLoad(TRUE);
            GetResInfo(seg, id, kind, segName);
            ProgramBreak(Concat('In ', s, ConcatNumber(' couldn''t load segment: ', segNum),
                                ' ', segName));
            {$ENDC}
            Failure(memFullErr, 0)
            END
        END
    ELSE
        BEGIN
        gIsResidentSeg^^[segNum] := FALSE;
        END;
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAMiniInit}

PROCEDURE SetStackSpace(numBytes: LONGINT);

    VAR
        curLimit:            LONGINT;
        newLimit:            LONGINT;

    BEGIN
    newLimit := Ord(GetCurStackBase) - numBytes;

    IF Ord(GetApplLimit) > newLimit THEN
        SetApplLimit(Ptr(newLimit));
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}
{$Push} {$IFC qTrace} {$D+} {$ENDC}

FUNCTION TotalTempSize(justLocked: BOOLEAN;
                       VAR canPurge: Handle): Size;

    VAR
        total:                Size;
        applZone:            THz;

    PROCEDURE TotalUp(h: Handle);

        VAR
            hIsLocked:            BOOLEAN;

        BEGIN
        IF NOT IsHandlePurged(h) THEN                    { in memory already }
            IF HandleZone(h) = applZone THEN            { in application heap }
                BEGIN
                HNoPurge(h);

                hIsLocked := IsHandleLocked(h);

                IF NOT justLocked | hIsLocked THEN
                    total := total + GetHandleSize(h) + 8;
                { add in the size plus heap overhead }

                IF NOT hIsLocked THEN
                    IF canPurge = NIL THEN
                        IF HandleIsEligible(h) THEN
                            canPurge := h;
                END;
        END;

    BEGIN
    canPurge := NIL;
    total := 0;
    applZone := ApplicZone;

    ScanHandles(TotalUp);

    TotalTempSize := total;
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}
{$Push} {$IFC qTrace} {$D+} {$ENDC}

PROCEDURE WithCodeResFileDo(PROCEDURE DoWithResFile);

    VAR
        oldResFile:         INTEGER;

    BEGIN
    oldResFile := MAUseResFile(gCodeRefNum);
    DoWithResFile;
    IF MAUseResFile(oldResFile) <> 0 THEN;
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}                     { no %_BP/%_EP allowed in here, because we
                                                         cannot call to any other segment from this
                                                         procedure }
{$S MAMemoryRes}                                        { must be in Main segment }

PROCEDURE UnloadAllSegments;

    VAR
        i:                    LONGINT;
        seg:                Handle;
        jumpTablePtr:        LONGINT;
        oldResLoad:         BOOLEAN;

    PROCEDURE DoToFrame(calleeFrame: LONGINT;
                        ppc: LONGINT;
                        callerFrame: LONGINT;
                        itsFrame: LONGINT);

        VAR
            seg:                INTEGER;

        BEGIN
        seg := GetSegFromPC(ppc);
        IF (seg <> 0) & NOT gIsResidentSeg^^[seg] & gIsLoadedSeg^^[seg] THEN
            BEGIN
            Writeln('Segment#: ', seg: 2);
            ProgramBreak(
       'I really don''t think that you want to unload a segment into which you are going to return!'
                         )
            END;
        END;

    PROCEDURE UnloadEm;

        VAR
            i:                    integer;

        BEGIN
        FOR i := 1 TO pMaxSegNum DO
            IF NOT gIsResidentSeg^^[i] & gIsLoadedSeg^^[i] THEN
                BEGIN
                seg := gCodeSegs^^[i];
                IF (seg <> NIL) & NOT IsHandlePurged(seg) THEN
                    BEGIN
                    UnLoadSeg(Ptr(jumpTablePtr + IntegerHandle(seg)^^ + 2));
                    gIsLoadedSeg^^[i] := FALSE;
                    END;
                END;
        END;

    BEGIN
    {$IFC qDebug}
    CheckRsrcUsage;
    {$ENDC}

    IF gUnloadAllSegs THEN
        BEGIN
        jumpTablePtr := Ord(GetA5) + GetCurJTOffset;

        {$IFC qDebug}
        EachFrameDo(Ord(GetCurStackFramePtr), Ord(GetCurStackFramePtr) + 4, DoToFrame);
        {$EndC}

        WithCodeResFileDo(UnloadEm);

        {$IFC qDebug}
        IF gSegReport THEN
            ProgramReport('  *** Just unloaded all segments ***', gMemMgtBreak);
        {$ENDC}
        END;
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$IFC qDebug}
{$S MADebug}

PROCEDURE WriteReserves;

{ WRITELN's the temporary reserve and low-memory reserves in the
debug window. }

    BEGIN
    WrLblPtr('Temporary reserve (pCodeReserve)', pCodeReserve); Writeln;
    WrLblPtr('Low-memory reserve (pMemReserve)', pMemReserve); Writeln;
    END;
{$ENDC}